• Home
 · 
• String Manipulation
 · 
• Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Rate Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    'MaxChars argument is the length of the displayable path name to return
    'ShrinkChar optional argument is the character to use for shortened version ("." is default)
    Private Function ShrinkFileName(ByVal NameToShrink As String, _
        ByVal MaxChars As Integer, Optional ByVal ShrinkChar As String = ".") As String

        Dim HideChar As String, szFileName As String, szDir() As String, R As Integer
        Dim nDirs As Integer, nDir1 As Integer, nDir2 As Integer, nDir3 As Integer, nDir4 As Integer, iCount As Integer

        If NameToShrink.Length < MaxChars Then
            'No change needed
            ShrinkFileName = NameToShrink
            Exit Function
        End If
        'Set Hide Character
        If ShrinkChar.Length > 0 Then
            HideChar = ShrinkChar.Substring(0, 1) & ShrinkChar.Substring(0, 1) & ShrinkChar.Substring(0, 1)
        Else
            HideChar = "." & "." & "."
        End If
        'Split the file name
        szDir = NameToShrink.Split("\")
        nDirs = szDir.Length - 1
        If nDirs < 1 Then
            'FileName can't be shrunk well, just
            'chop off beginning characters to fit
            R = NameToShrink.Length - MaxChars
            If R < 0 Then R = 0
            ShrinkFileName = NameToShrink.Substring(R)
            Exit Function
        End If
        'Re-add the "\"s
        For iCount = 0 To nDirs
            szDir(iCount) = "\" & szDir(iCount)
        Next iCount
        If szDir(nDirs).Length >= MaxChars Or szDir(0).Length >= MaxChars Then
            'FileName can't be shrunk well, just
            'chop off the end of the file name
            'to fit.
            ShrinkFileName = szDir(nDirs).Substring(0, MaxChars)
            Exit Function
        End If
        'Start the shrunken FileName
        ShrinkFileName = szDir(0)
        'Get Section lengths
        nDir1 = szDir(0).Length           'Drive Letter
        nDir2 = szDir(1).Length           'First Directory or File Name
        szFileName = szDir(1)
        If nDirs > 1 Then
            nDir3 = szDir(2).Length       'Second Directory of File Name
            szFileName = szDir(2)
        Else
            nDir3 = 0
        End If
        If nDirs > 2 Then
            nDir4 = szDir(nDirs).Length   'File Name
            szFileName = szDir(nDirs)
        Else
            nDir4 = 0
        End If
        'Worst case scenario (of remaining)
        If nDir1 + szFileName.Length + HideChar.Length > MaxChars Then
            ShrinkFileName = szFileName
            Exit Function
        End If
        'Next best
        ShrinkFileName = ShrinkFileName & HideChar & szFileName
        If ShrinkFileName.Length + nDir2 >= MaxChars Or nDir2 < 1 Then
            Exit Function
        Else
            ShrinkFileName = szDir(0) & szDir(1) & HideChar & szFileName
        End If
        'Next best
        If ShrinkFileName.Length + nDir3 >= MaxChars Or nDir3 < 1 Then
            Exit Function
        Else
            ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & HideChar & szFileName
        End If
        'Best case scenario
        If ShrinkFileName.Length + nDir4 <= MaxChars Then
            ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & szDir(3) & HideChar & szFileName
        End If
    End Function